home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Examples / Demos / Prelude < prev    next >
Lisp/Scheme  |  1998-10-26  |  7KB  |  204 lines
  1. ; gen-expansion and harmonizer demo
  2. ; by Peter Stone
  3. ; to analyze the score double-click high-lighted keywords
  4.  
  5. (def-orchestra 'orchestra
  6.    instruments (lefthand righthand 3rd-voice)
  7. )
  8.  
  9. (def-grammar 'structure
  10.    sections (intro prelude fugue)
  11. )
  12.  
  13. (setq melody-1 (symbol-fold 12 0 
  14.                             (gen-expansion 1 
  15.                                            (change-to-symbols '(0 0  0 0  0 0  5 5  4 4 4)) 
  16.                                            (gen-repeat 2 '(h c b c  a c b c)))))
  17. (setq melody-2 (symbol-fold 12 0 
  18.                             (gen-expansion 1 
  19.                                            (change-to-symbols '(0 0  0 0  0 0  5 5  4 2 4)) 
  20.                                            (gen-repeat 2 '(a e d e  c e d e)))))
  21.  
  22. (def-section intro
  23.   default 
  24.     zone '(1/1 1/1 1/1 1/1  1/1 1/1 1/1 1/1
  25.            1/1 1/1 1/1 1/1  1/1 1/1 1/1 1/1
  26.            1/1 1/1 1/1 1/1  1/1 1/1 1/1 1/1)
  27.     tempo-zones (same-as zone of default)
  28.     tempo '(98) 
  29.     length '(1/16)
  30.     velocity '(64)
  31.   righthand
  32.     tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor g 5)))
  33.     symbol melody-1
  34.     channel 1 
  35.     program (gm-sound-set pizzicato-strings)
  36.   lefthand
  37.     tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 4) (major d 4) (melodic-minor g 4)))
  38.     symbol melody-2
  39.     channel 2
  40.     program (gm-sound-set pizzicato-strings)
  41.   3rd-voice
  42.     tonality (activate-tonality (melodic-minor c 5))
  43.     channel 5 
  44.     program (gm-sound-set acoustic-grand-piano)
  45.     length '(1/16)
  46.     symbol '(=)
  47.     velocity '(0)
  48. )
  49.  
  50. ;;; part b
  51.  
  52. (setq theme 
  53.       (gen-expansion 1 
  54.                      (change-to-symbols '(0 0  0 0  0 0  5 5  4 4 4)) 
  55.                      '(h c b c  a c b c)))
  56.  
  57. (setq melody-1-source 
  58.    (append theme 
  59.            (symbol-transpose 8 
  60.            (symbol-inversion 'a theme))))
  61.  
  62. (setq melody-2-source  
  63.     (symbol-transpose 11 
  64.          (symbol-shift 32 
  65.               (append theme 
  66.                       (symbol-transpose 8 
  67.                            (symbol-inversion 'a theme))))))
  68.  
  69. (setq harmonized-melodies
  70.    (filter-harmonize2 melody-1-source melody-2-source 12 
  71.                    (activate-tonality (harmonic-minor g 3))
  72.                    '((4 4))
  73.                    '((1 2 6 8 10 11))))
  74.  
  75. (setq melody-1-mat (symbol-fold 21 0 (filter-deactivate 8 30 (find-change (car harmonized-melodies)))))
  76. (setq melody-2-mat (symbol-fold 21 0 (filter-deactivate 8 30 (find-change (cadr harmonized-melodies)))))
  77.  
  78. (setq melody-1 melody-1-mat)
  79.  
  80. (setq melody-2
  81.       (symbol-remove
  82.        (find-common melody-1-mat melody-2-mat)
  83.        melody-2-mat))
  84.  
  85. (setq tempo-zone-len (/ (get-ratio '12/1 :ratio)
  86.                         (get-ratio '1/8 :ratio)))
  87.  
  88. (def-section prelude
  89.   default
  90.     zone '(12/1)
  91.     tempo-zones (symbol-trim tempo-zone-len '(1/8))
  92.     tempo       (vector-to-list (vector-round 65 90 (gen-fourier 
  93.                       '(1 2 5 7) ; frequencies
  94.                       '(0.6 0.2 (gen-sin 10 0.22 64) 0.2) ; amplitudes
  95.                       '(0 45 90) ; initial phases
  96.                       tempo-zone-len)))
  97.     tonality (activate-tonality (harmonic-minor g 3))
  98.   lefthand
  99.     channel 3 
  100.     program (gm-sound-set acoustic-grand-piano)
  101.     symbol (symbol-melodize-skip melody-1)
  102.     length (get-timing '1/16 melody-1)
  103.     velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
  104.   righthand
  105.     channel 4 
  106.     program (gm-sound-set acoustic-grand-piano)
  107.     symbol (symbol-shift 1 (symbol-melodize-skip melody-2))
  108.     length (get-timing '1/16 melody-2)
  109.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  110.   3rd-voice
  111.     channel 5 
  112.     program (gm-sound-set acoustic-grand-piano)
  113.     length '(1/16)
  114.     symbol '(=)
  115.     velocity '(0)
  116. )
  117.  
  118. ;;; fugue
  119.  
  120. (setq theme-source 
  121.       (gen-random-variate 0.81 0.5 1 1 '(a e d e  c e d e  a b c d b d c b  h c b c  a c b c  d e d b c b a -b)))
  122.  
  123. (setq theme theme-source)
  124.  
  125. (setq theme-enhansion
  126.       (gen-expansion 1 '(a d c -c b)
  127.                         (symbol-retrograde 
  128.                          (gen-loop '((8 1 1 4) (2 1 1 2))
  129.                                    theme))))
  130.  
  131. (init-rnd 0.453)
  132. (init-soup 'bach-soup theme-enhansion)
  133.  
  134. (setq variations 
  135.     (symbol-trim (* (length theme) 6) 
  136.          (gen-catalyze 'bach-soup 0.1521412123425 30)))
  137.  
  138. (setq melody-1-source 
  139.       (append theme 
  140.               (symbol-transpose 8 
  141.                                 (symbol-inversion 'a theme)) 
  142.               variations))
  143.  
  144. (setq melody-2-source  
  145.       (symbol-transpose -3 
  146.                         (symbol-shift (* 32 1 2) 
  147.                                       (append theme 
  148.                                               (symbol-transpose 8 
  149.                                                                 (symbol-inversion 'a theme)) 
  150.                                               variations))))
  151.  
  152. (setq melody-3-source
  153.       (symbol-transpose -5 
  154.                         (symbol-shift (* 32 2 2) 
  155.                                       (append theme 
  156.                                               (symbol-transpose 8 
  157.                                                                 (symbol-inversion 'a theme)) 
  158.                                               variations))))
  159.  
  160. (setq harmonized-melodies
  161.       (filter-harmonize3
  162.           melody-1-source melody-2-source melody-3-source 12
  163.           (activate-tonality (harmonic-minor g 3))
  164.           '((64 3) (32 3)) 
  165.           '((1 2 6 8 10 11))
  166.           '(0 5 7)))
  167.  
  168. (setq melody-1 (symbol-fold 14 0 (filter-deactivate 16 69 (find-change (car harmonized-melodies)))))
  169. (setq melody-2 (symbol-fold 21 0 (filter-deactivate 16 69 (find-change (cadr harmonized-melodies)))))
  170. (setq melody-3 (symbol-fold 14 0 (filter-deactivate 16 69 (find-change (caddr harmonized-melodies)))))
  171.  
  172. (def-section fugue
  173.   default
  174.     zone '(16/1)
  175.     tempo-zones (same-as zone of default)
  176.     tempo '(79)
  177.     tonality (activate-tonality (harmonic-minor g 3))
  178.   lefthand
  179.     channel 1 
  180.     program (gm-sound-set synth-bass-2)
  181.     length (get-timing '1/16 melody-1)
  182.     symbol (symbol-melodize-skip melody-1)
  183.     velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
  184.   righthand
  185.     channel 4 
  186.     program (gm-sound-set fx-1-rain)
  187.     length (get-timing '1/16 melody-2)
  188.     symbol (symbol-shift 1 (symbol-melodize-skip melody-2)) 
  189.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  190.   3rd-voice
  191.     channel 5 
  192.     tonality (activate-tonality (harmonic-minor g 5))
  193.     program (gm-sound-set lead-1-square)
  194.     length (get-timing '1/16 melody-3)
  195.     symbol (symbol-shift 1 (symbol-melodize-skip melody-3))
  196.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  197. )
  198.  
  199. (midiport :printer)
  200.  
  201. (play-file-p "prelude midi"
  202.   instruments '(sections)
  203. )
  204.